home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / COMM.SWG / 0008_EMSI.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  7KB  |  294 lines
  1. {
  2. TERRY GRANT
  3.  
  4. Here is a Unit I posted some time ago For use With EMSI Sessions. Hope it
  5. helps some of you out. You will require a fossil or Async Interface for
  6. this to compile!
  7. }
  8.  
  9. Program Emsi;
  10.  
  11. Uses
  12.   Dos , Crt, Fossil;
  13.  
  14. Type
  15.   HexString = String[4];
  16.  
  17. Const
  18.   FingerPrint          = '{EMSI}';
  19.   System_Address       = '1:210/20.0';      { Your address }
  20.   PassWord             = 'PASSWord';        { Session passWord }
  21.   Link_Codes           = '{8N1}';           { Modem setup }
  22.   Compatibility_Codes  = '{JAN}';           { Janis }
  23.   Mailer_Product_Code  = '{00}';
  24.   Mailer_Name          = 'MagicMail';
  25.   Mailer_Version       = '1.00';
  26.   Mailer_Serial_Number = '{Alpha}';
  27.   EMSI_INQ : String = '**EMSI_INQC816';
  28.   EMSI_REQ : String = '**EMSI_REQA77E';
  29.   EMSI_ACK : String = '**EMSI_ACKA490';
  30.   EMSI_NAK : String = '**EMSI_NAKEEC3';
  31.   EMSI_CLI : String = '**EMSI_CLIFA8C';
  32.   EMSI_ICI : String = '**EMSI_ICI2D73';
  33.   EMSI_HBT : String = '**EMSI_HBTEAEE';
  34.   EMSI_IRQ : String = '**EMSI_IRQ8E08';
  35.  
  36. Var
  37.   EMSI_DAT : String;            { NOTE : EMSI_DAT has no maximum length }
  38.   Length_EMSI_DAT : HexString;  { Expressed in Hexidecimal }
  39.   Packet : String;
  40.   Rec_EMSI_DAT : String;        { EMSI_DAT sent by the answering system }
  41.   Len_Rec_EMSI_DAT : Word;
  42.  
  43.   Len,
  44.   CRC : HexString;
  45.  
  46.   R : Registers;
  47.   C : Char;
  48.   Loop,ComPort,TimeOut,Tries : Byte;
  49.   Temp : String;
  50.  
  51. Function Up_Case(St : String) : String;
  52. begin
  53.   For Loop := 1 to Length(St) do
  54.     St[Loop] := Upcase(St[Loop]);
  55.  
  56.   Up_Case := St;
  57. end;
  58.  
  59. Function Hex(i : Word) : HexString;
  60. Const
  61.   hc : Array[0..15] of Char = '0123456789ABCDEF';
  62. Var
  63.   l, h : Byte;
  64. begin
  65.   l := Lo(i);
  66.   h := Hi(i);
  67.   Hex[0] := #4;          { Length of String = 4 }
  68.   Hex[1] := hc[h shr 4];
  69.   Hex[2] := hc[h and $F];
  70.   Hex[3] := hc[l shr 4];
  71.   Hex[4] := hc[l and $F];
  72. end {Hex} ;
  73.  
  74. Function Power(Base,E : Byte) : LongInt;
  75. begin
  76.   Power := Round(Exp(E * Ln(Base) ));
  77. end;
  78.  
  79. Function Hex2Dec(HexStr : String) : LongInt;
  80.  
  81. Var
  82.   I,HexBit : Byte;
  83.   Temp : LongInt;
  84.   Code : Integer;
  85.  
  86. begin
  87.   Temp := 0;
  88.   For I := Length(HexStr) downto 1 do
  89.   begin
  90.     If HexStr[I] in ['A','a','B','b','C','c','D','d','E','e','F','f'] then
  91.       Val('$' + HexStr[I],HexBit,Code)
  92.     else
  93.       Val(HexStr[I],HexBit,Code);
  94.     Temp := Temp + HexBit * Power(16,Length(HexStr) - I);
  95.   end;
  96.   Hex2Dec := Temp;
  97. end;
  98.  
  99. Function Bin2Dec(BinStr : String) : LongInt;
  100.  
  101. { Maximum is 16 bits, though a requirement For more would be   }
  102. { easy to accomodate.  Leading zeroes are not required. There  }
  103. { is no error handling - any non-'1's are taken as being zero. }
  104.  
  105. Var
  106.   I : Byte;
  107.   Temp : LongInt;
  108.   BinArray : Array[0..15] of Char;
  109.  
  110. begin
  111.   For I := 0 to 15 do
  112.     BinArray[I] := '0';
  113.   For I := 0 to Pred(Length(BinStr)) do
  114.     BinArray[I] := BinStr[Length(BinStr) - I];
  115.   Temp := 0;
  116.   For I := 0 to 15 do
  117.   If BinArray[I] = '1' then
  118.     inc(Temp,Round(Exp(I * Ln(2))));
  119.   Bin2Dec := Temp;
  120. end;
  121.  
  122. Function CRC16(s:String):Word;  { By Kevin Cooney }
  123. Var
  124.   crc : LongInt;
  125.   t,r : Byte;
  126. begin
  127.   crc:=0;
  128.   For t:=1 to length(s) do
  129.   begin
  130.     crc:=(crc xor (ord(s[t]) shl 8));
  131.     For r:=1 to 8 do
  132.     if (crc and $8000)>0 then
  133.       crc:=((crc shl 1) xor $1021)
  134.     else
  135.       crc:=(crc shl 1);
  136.   end;
  137.   CRC16:=(crc and $FFFF);
  138. end;
  139.  
  140. {**** FOSSIL Routines ****}
  141. {**** Removed from Code ***}
  142.  
  143. Procedure Hangup;
  144. begin
  145.   Write2Port('+++'+#13);
  146. end;
  147.  
  148. {**** EMSI Handshake Routines ****}
  149.  
  150. Procedure Create_EMSI_DAT;
  151. begin
  152.   FillChar(EMSI_DAT,255,' ');
  153.  
  154.   EMSI_DAT := FingerPrint + '{' + System_Address + '}{'+ PassWord + '}' +
  155.               Link_Codes + Compatibility_Codes + Mailer_Product_Code +
  156.               '{' + Mailer_Name + '}{' + Mailer_Version + '}' +
  157.               Mailer_Serial_Number;
  158.  
  159.   Length_EMSI_DAT := Hex(Length(EMSI_DAT));
  160. end;
  161.  
  162. Function Carrier_Detected : Boolean;
  163. begin
  164.   TimeOut := 20;   { Wait approximately 20 seconds }
  165.   Repeat
  166.     Delay(1000);
  167.     Dec(TimeOut);
  168.   Until (TimeOut = 0) or (Lo(StatusReq) and $80 = $80);
  169.  
  170.   If Timeout = 0 then
  171.     Carrier_Detected := False
  172.   else
  173.     Carrier_Detected := True;
  174. end;
  175.  
  176. Function Get_EMSI_REQ : Boolean;
  177. begin
  178.   Temp := '';
  179.   Purge_Input;
  180.  
  181.   Repeat
  182.     C := ReadKeyfromPort;
  183.     If (C <> #10) and (C <> #13) then
  184.       Temp := Temp + C;
  185.   Until Length(Temp) = Length(EMSI_REQ);
  186.  
  187.   If Up_Case(Temp) = EMSI_REQ then
  188.     get_EMSI_REQ := True
  189.   else
  190.     get_EMSI_REQ := False;
  191. end;
  192.  
  193. Procedure Send_EMSI_DAT;
  194. begin
  195.   CRC := Hex(CRC16('EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT));
  196.   Write2Port('**EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT + CRC);
  197. end;
  198.  
  199. Function Get_EMSI_ACK : Boolean;
  200. begin
  201.   Temp := '';
  202.  
  203.   Repeat
  204.     C := ReadKeyfromPort;
  205.     If (C <> #10) and (C <> #13) then
  206.       Temp := Temp + C;
  207.   Until Length(Temp) = Length(EMSI_ACK);
  208.  
  209.   If Up_Case(Temp) = EMSI_ACK then
  210.     get_EMSI_ACK := True
  211.   else
  212.     get_EMSI_ACK := False;
  213. end;
  214.  
  215. Procedure Get_EMSI_DAT;
  216. begin
  217.   Temp := '';
  218.   For Loop := 1 to 10 do                  { Read in '**EMSI_DAT' }
  219.     Temp := Temp + ReadKeyfromPort;
  220.  
  221.   Delete(Temp,1,2);                       { Remove the '**'      }
  222.  
  223.   Len := '';
  224.   For Loop := 1 to 4 do                   { Read in the length   }
  225.     Len := Len + ReadKeyFromPort;
  226.  
  227.   Temp := Temp + Len;
  228.  
  229.   Len_Rec_EMSI_DAT := Hex2Dec(Len);
  230.  
  231.   Packet := '';
  232.   For Loop := 1 to Len_Rec_EMSI_DAT do    { Read in the packet   }
  233.     Packet := Packet + ReadKeyfromPort;
  234.  
  235.   Temp := Temp + Packet;
  236.  
  237.   CRC := '';
  238.   For Loop := 1 to 4 do                   { Read in the CRC      }
  239.     CRC := CRC + ReadKeyFromPort;
  240.  
  241.   Rec_EMSI_DAT := Packet;
  242.  
  243.   Writeln('Rec_EMSI_DAT = ',Rec_EMSI_DAT);
  244.  
  245.   If Hex(CRC16(Temp)) <> CRC then
  246.     Writeln('The recieved EMSI_DAT is corrupt!!!!');
  247. end;
  248.  
  249. begin
  250.   { Assumes connection has been made at this point }
  251.  
  252.   Tries := 0;
  253.   Repeat
  254.     Write2Port(EMSI_INQ);
  255.     Delay(1000);
  256.     Inc(Tries);
  257.   Until (Get_EMSI_REQ = True) or (Tries = 5);
  258.  
  259.   If Tries = 5 then
  260.   begin
  261.     Writeln('Host system failed to acknowledge the inquiry sequence.');
  262.     Hangup;
  263.     Halt;
  264.   end;
  265.  
  266.   { Used For debugging }
  267.   Writeln('Boss has acknowledged receipt of EMSI_INQ');
  268.  
  269.   Send_EMSI_DAT;
  270.  
  271.   Tries := 0;
  272.   Repeat
  273.     Inc(Tries);
  274.   Until (Get_EMSI_ACK = True) or (Tries = 5);
  275.  
  276.   If Tries = 5 then
  277.   begin
  278.     Writeln('Host system failed to acknowledge the EMSI_DAT packet.');
  279.     Hangup;
  280.     halt;
  281.   end;
  282.  
  283.   Writeln('Boss has acknowledged receipt of EMSI_DAT');
  284.  
  285.   Get_EMSI_DAT;
  286.   Write2Port(EMSI_ACK);
  287.  
  288.   { Normally the File transfers would start at this point }
  289.   Hangup;
  290. end.
  291.  
  292. {
  293.  This DOES not include all the possibilities in an EMSI Session.
  294. }